DATA 2020

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

day = read.csv("/Users/Murphy1/Desktop/DATA2020/Project2020/data/hour.csv", header = TRUE)

Warning message:
package ‘lme4’ was built under R version 4.1.2 

head(day)

library(pheatmap)
library(ggplot2)

Warning: package ‘ggplot2’ was built under R version 4.1.2

library(dslabs)
library(dplyr)
library(forcats)
library(reshape2)
library(tidyr)

Warning: package ‘tidyr’ was built under R version 4.1.2
Attaching package: ‘tidyr’

The following object is masked from ‘package:reshape2’:

    smiths

The following objects are masked from ‘package:Matrix’:

    expand, pack, unpack

day1 <- lapply(day1, function(x) as.numeric(x))
day1 <- data.frame(day1)

y <- day1$cnt
X <- dplyr::select(day1, -c(cnt))

corr <- round(cor(X),2)

get_upper_tri<-function(corr){
    corr[lower.tri(corr, diag=TRUE)] <- NA
    return(corr)
}
upper <- get_upper_tri(corr)
melted_upper <- melt(upper, na.rm=TRUE)

ggplot(data = melted_upper, aes(Var2, Var1, fill = value))+
 geom_tile(color = "white")+
 scale_fill_gradient2(low = "yellow", high = "brown", mid = "white", 
   midpoint = 0, limit = c(-1,1), space = "Lab") +
  theme(
  axis.text.x = element_text(angle = 45, vjust = 1, 
    size = 4, hjust = 1),
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  panel.grid.major = element_blank(),
  panel.border = element_blank(),
  panel.background = element_blank(),
  axis.ticks = element_blank())+
  geom_text(aes(Var2, Var1, label = value), color = "gray", size = 3) +
  coord_fixed() +
  labs(fill='correlation') 

#drop atemp
day1 <- dplyr::select(day1, -c(atemp))
day1

# Check Line

fit.all = lm(cnt ~ season + yr + mnth + hr + holiday + workingday + weathersit + temp + hum + windspeed, data = day1)

intercept_only <- lm(cnt ~ 1, data=day1)

forward <- step(intercept_only, direction='forward', 
                scope=formula(fit.all))

Start:  AIC=180764.7
cnt ~ 1

             Df Sum of Sq       RSS    AIC
+ temp        1  93677759 478083832 177657
+ hr          1  88790198 482971393 177834
+ hum         1  59618351 512143240 178853
+ yr          1  35876722 535884870 179641
+ season      1  18127040 553634551 180207
+ weathersit  1  11598301 560163290 180411
+ mnth        1   8321115 563440476 180512
+ windspeed   1   4970060 566791531 180615
+ holiday     1    546889 571214702 180750
+ workingday  1    524387 571237204 180751
<none>                    571761591 180765

Step:  AIC=177657
cnt ~ temp

             Df Sum of Sq       RSS    AIC
+ hr          1  66728221 411355610 175046
+ hum         1  49874585 428209247 175744
+ yr          1  31342263 446741569 176481
+ windspeed   1   6021342 472062489 177439
+ weathersit  1   5880680 472203151 177444
+ season      1   1696802 476387030 177597
+ mnth        1    906463 477177369 177626
+ holiday     1    225697 477858135 177651
<none>                    478083832 177657
+ workingday  1     35467 478048365 177658

Step:  AIC=175046.4
cnt ~ temp + hr

             Df Sum of Sq       RSS    AIC
+ yr          1  32229070 379126540 173631
+ hum         1  25434149 385921461 173939
+ weathersit  1   5638993 405716617 174809
+ season      1   2995571 408360039 174921
+ windspeed   1   1712372 409643238 174976
+ mnth        1   1525503 409830107 174984
+ holiday     1    260174 411095436 175037
+ workingday  1     54016 411301595 175046
<none>                    411355610 175046

Step:  AIC=173630.5
cnt ~ temp + hr + yr

             Df Sum of Sq       RSS    AIC
+ hum         1  20865128 358261412 172649
+ weathersit  1   5240157 373886383 173391
+ season      1   3515639 375610901 173471
+ mnth        1   1811568 377314972 173549
+ windspeed   1   1810495 377316045 173549
+ holiday     1    307712 378818828 173618
+ workingday  1     66617 379059923 173629
<none>                    379126540 173631

Step:  AIC=172648.7
cnt ~ temp + hr + yr + hum

             Df Sum of Sq       RSS    AIC
+ season      1   7325038 350936374 172292
+ mnth        1   4840141 353421271 172414
+ holiday     1    367007 357894405 172633
+ weathersit  1    133898 358127514 172644
+ workingday  1    117604 358143808 172645
<none>                    358261412 172649
+ windspeed   1     15517 358245895 172650

Step:  AIC=172291.7
cnt ~ temp + hr + yr + hum + season

             Df Sum of Sq       RSS    AIC
+ holiday     1    371167 350565206 172275
+ windspeed   1    165365 350771008 172286
+ workingday  1    131868 350804506 172287
<none>                    350936374 172292
+ weathersit  1     37972 350898402 172292
+ mnth        1       799 350935575 172294

Step:  AIC=172275.3
cnt ~ temp + hr + yr + hum + season + holiday

             Df Sum of Sq       RSS    AIC
+ windspeed   1    165343 350399863 172269
+ workingday  1     47102 350518104 172275
+ weathersit  1     42022 350523184 172275
<none>                    350565206 172275
+ mnth        1         0 350565206 172277

Step:  AIC=172269.1
cnt ~ temp + hr + yr + hum + season + holiday + windspeed

             Df Sum of Sq       RSS    AIC
+ weathersit  1     73738 350326125 172267
+ workingday  1     48197 350351667 172269
<none>                    350399863 172269
+ mnth        1         1 350399863 172271

Step:  AIC=172267.5
cnt ~ temp + hr + yr + hum + season + holiday + windspeed + weathersit

             Df Sum of Sq       RSS    AIC
+ workingday  1     53900 350272225 172267
<none>                    350326125 172267
+ mnth        1         1 350326124 172269

Step:  AIC=172266.8
cnt ~ temp + hr + yr + hum + season + holiday + windspeed + weathersit + 
    workingday

       Df Sum of Sq       RSS    AIC
<none>              350272225 172267
+ mnth  1      1.92 350272223 172269

summary(forward)

Call:
lm(formula = cnt ~ temp + hr + yr + hum + season + holiday + 
    windspeed + weathersit + workingday, data = day1)

Residuals:
    Min      1Q  Median      3Q     Max 
-366.86  -93.52  -27.97   60.40  644.46 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)   -9.4775     6.5712  -1.442 0.149246    
temp         282.8600     6.0073  47.086  < 2e-16 ***
hr             7.6962     0.1649  46.680  < 2e-16 ***
yr            80.9848     2.1668  37.376  < 2e-16 ***
hum         -197.1206     6.8663 -28.708  < 2e-16 ***
season        20.0853     1.0486  19.154  < 2e-16 ***
holiday      -25.1349     6.6610  -3.773 0.000162 ***
windspeed     29.5888     9.4015   3.147 0.001651 ** 
weathersit    -3.7797     1.9044  -1.985 0.047187 *  
workingday     3.9204     2.3980   1.635 0.102096    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 142 on 17369 degrees of freedom
Multiple R-squared:  0.3874,    Adjusted R-squared:  0.3871 
F-statistic:  1220 on 9 and 17369 DF,  p-value: < 2.2e-16

#forward

backward <- step(fit.all, direction='backward')

Start:  AIC=172268.8
cnt ~ season + yr + mnth + hr + holiday + workingday + weathersit + 
    temp + hum + windspeed

             Df Sum of Sq       RSS    AIC
- mnth        1         2 350272225 172267
<none>                    350272223 172269
- workingday  1     53901 350326124 172269
- weathersit  1     79432 350351655 172271
- windspeed   1    199754 350471977 172277
- holiday     1    286716 350558939 172281
- season      1   2453586 352725809 172388
- hum         1  16562243 366834466 173070
- yr          1  28170183 378442406 173611
- hr          1  43896453 394168676 174319
- temp        1  44245313 394517536 174334

Step:  AIC=172266.8
cnt ~ season + yr + hr + holiday + workingday + weathersit + 
    temp + hum + windspeed

             Df Sum of Sq       RSS    AIC
<none>                    350272225 172267
- workingday  1     53900 350326125 172267
- weathersit  1     79442 350351667 172269
- windspeed   1    199752 350471977 172275
- holiday     1    287145 350559370 172279
- season      1   7398820 357671045 172628
- hum         1  16620569 366892794 173070
- yr          1  28171966 378444191 173609
- hr          1  43943958 394216183 174319
- temp        1  44711469 394983694 174353

summary(backward)

Call:
lm(formula = cnt ~ season + yr + hr + holiday + workingday + 
    weathersit + temp + hum + windspeed, data = day1)

Residuals:
    Min      1Q  Median      3Q     Max 
-366.86  -93.52  -27.97   60.40  644.46 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)   -9.4775     6.5712  -1.442 0.149246    
season        20.0853     1.0486  19.154  < 2e-16 ***
yr            80.9848     2.1668  37.376  < 2e-16 ***
hr             7.6962     0.1649  46.680  < 2e-16 ***
holiday      -25.1349     6.6610  -3.773 0.000162 ***
workingday     3.9204     2.3980   1.635 0.102096    
weathersit    -3.7797     1.9044  -1.985 0.047187 *  
temp         282.8600     6.0073  47.086  < 2e-16 ***
hum         -197.1206     6.8663 -28.708  < 2e-16 ***
windspeed     29.5888     9.4015   3.147 0.001651 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 142 on 17369 degrees of freedom
Multiple R-squared:  0.3874,    Adjusted R-squared:  0.3871 
F-statistic:  1220 on 9 and 17369 DF,  p-value: < 2.2e-16

library(glmnet)

Warning: package ‘glmnet’ was built under R version 4.1.2Loaded glmnet 4.1-6

day2 <- day1 %>% dplyr::select(-c(casual, registered))
#day2
day2$cnt <- log(day2$cnt)
#day2
x <- model.matrix(day2$cnt~., day2)[,-1]
y <- day2 %>% dplyr::select(cnt) %>% unlist() %>% as.numeric()

#y
grid <- 10^seq(2, -3, by=-.1)

train <- day2 %>% sample_frac(0.8)
test <- day2 %>% setdiff(train)

x_train <- model.matrix(train$cnt~., train)[,-1]
x_test <- model.matrix(test$cnt~., test)[,-1]
cnt <- day2$cnt
#cnt
y_train <- train %>% dplyr::select(cnt) %>% unlist() %>% as.numeric()
y_test <- test %>% dplyr::select(cnt) %>% unlist() %>% as.numeric()
set.seed(1)

#on the full model
out <- glmnet(x, y, alpha = 1, lambda = grid) 

#cv to choose best lambda
cv.out <- cv.glmnet(x_train, y_train, alpha = 1) 
bestlam <- cv.out$lambda.min 
cat('Best lambda obtained is: ', bestlam)

Best lambda obtained is:  0.002373813

#lasso with best lambda
lasso <- glmnet(x, y, alpha = 1, lambda = bestlam)
predictions <- predict(lasso, type = "coefficients", s = bestlam)
#coef(lasso, s=bestlam)

#remove intercept
lasso.mod <- glmnet(x,y, alpha =1)
beta <- coef(lasso.mod)
beta <- as.matrix(beta)
dim(beta)

[1] 12 64

lambda <- lasso.mod$lambda
length(lambda)

[1] 64

lam <- rep(lambda, 11)
length(lam)

[1] 704

beta_t <- t(beta)
beta_vec <- as.vector(beta_t)[-c(1:64)]
length(beta_vec)

[1] 704

v <- rownames(beta)[-1]
length(v)

[1] 11

names <- rep(v, each=64)
length(beta_vec)

[1] 704

length(names)

[1] 704

df <- data.frame(lam, names, beta_vec)
plot <- ggplot(df, aes(x = lam, y = beta_vec, color = names)) +
  geom_line() +
  labs(x = "log(lambda)", y = "Coefficient") +
  theme_bw() +
  scale_x_continuous(trans='log10')

plot + ggtitle('Lasso coefficients vs. lambda')

#x_test
lasso_pred <- predict(lasso, newx = x_test, s = bestlam)
#y_test

lasso_pred

           s1
1    3.327497
2    3.607228
3    4.233416
4    4.331124
5    2.492397
6    2.458046
7    2.689060
8    3.388345
9    3.887150
10   4.895353
11   2.679571
12   3.419003
13   4.079738
14   4.388454
15   4.490119
16   2.332425
17   2.545692
18   3.700074
19   4.318007
20   4.482110
21   3.000057
22   4.597565
23   4.546019
24   2.586021
25   4.272679
26   4.371852
27   2.938359
28   4.459589
29   4.799030
30   2.518713
31   2.680288
32   3.122640
33   4.325406
34   4.520829
35   4.490768
36   4.927006
37   3.900033
38   4.085184
39   4.259374
40   4.395253
41   4.459296
42   4.461077
43   2.576039
44   2.703916
45   2.909863
46   4.015447
47   4.422219
48   4.329575
49   4.422998
50   2.802444
51   3.195344
52   3.453486
53   3.499243
54   3.600908
55   1.964766
56   2.298542
57   3.211613
58   3.960665
59   4.283840
60   4.488523
61   2.790898
62   3.752816
63   4.039743
64   4.585970
65   2.861613
66   3.828695
67   4.100278
68   4.250609
69   2.425850
70   2.449356
71   2.942071
72   4.383873
73   4.720161
74   2.474499
75   2.512899
76   3.120426
77   3.282731
78   4.553515
79   2.505050
80   2.986818
81   3.200660
82   4.032182
83   4.080645
84   3.197103
85   1.862906
86   2.492568
87   2.652526
88   2.990622
89   3.208655
90   4.372409
91   5.049563
92   2.589556
93   2.691221
94   3.839485
95   4.029710
96   4.334268
97   4.580727
98   3.628551
99   4.350895
100  4.632017
101  2.526320
102  2.671232
103  3.310248
104  3.170265
105  4.272656
106  4.396243
107  4.470224
108  4.642786
109  2.498270
110  3.401551
111  4.513830
112  2.127647
113  2.203101
114  2.433338
115  2.725373
116  3.489350
117  4.223197
118  4.357513
119  2.141200
120  2.639242
121  2.604912
122  2.953858
123  2.955900
124  2.523597
125  3.337245
126  3.445452
127  4.139751
128  2.132313
129  2.986314
130  3.855930
131  3.887112
132  4.081057
133  4.182722
134  3.250235
135  3.902923
136  4.345523
137  2.435368
138  3.799284
139  3.910681
140  1.885736
141  2.197274
142  3.465453
143  4.784784
144  2.768771
145  3.112293
146  4.006621
147  4.546583
148  4.652195
149  3.833588
150  4.262285
151  2.502848
152  2.402539
153  3.290085
154  3.522898
155  2.539819
156  4.386867
157  2.295085
158  2.358002
159  2.420808
160  3.694602
161  3.968676
162  2.155620
163  2.370592
164  4.511441
165  4.773605
166  3.378624
167  4.150753
168  4.249036
169  3.868610
170  1.858560
171  3.395230
172  4.470420
173  4.522586
174  4.596224
175  3.698912
176  4.686116
177  4.653910
178  2.459404
179  4.245263
180  4.895937
181  4.773810
182  4.923226
183  3.134863
184  4.341574
185  5.164297
186  3.097379
187  3.520417
188  3.825101
189  5.216863
190  2.727410
191  3.565618
192  4.705231
193  4.879386
194  4.883334
195  3.022184
196  3.253087
197  3.786509
198  4.131287
199  4.349560
200  4.894292
201  4.946719
202  4.419196
203  3.798369
204  3.773825
205  3.922571
206  4.200902
207  5.133665
208  5.148197
209  3.259551
210  4.126336
211  3.045316
212  3.431797
213  3.801042
214  3.254977
215  3.853019
216  4.650846
217  2.354418
218  2.612082
219  2.833087
220  3.367444
221  4.033044
222  4.320198
223  4.121418
224  2.102325
225  3.952628
226  4.340074
227  4.441740
228  4.752820
229  4.630950
230  4.745721
231  2.177564
232  3.252980
233  4.967293
234  3.371288
235  3.864972
236  3.728154
237  2.435519
238  2.650226
239  3.073149
240  4.314269
241  2.240630
242  2.762062
243  3.069516
244  3.043094
245  3.492485
246  5.286824
247  5.201524
248  5.184436
249  5.294191
250  3.144341
251  3.205006
252  4.584187
253  2.438944
254  2.445849
255  4.570949
256  4.666162
257  2.425055
258  3.134597
259  4.209923
260  4.473452
261  5.046737
262  2.580474
263  2.830584
264  3.012566
265  3.151750
266  2.495160
267  2.740166
268  4.251607
269  4.359815
270  4.795046
271  4.916017
272  2.678347
273  3.618977
274  4.253857
275  4.484871
276  2.589584
277  2.650484
278  4.744198
279  4.880111
280  2.061120
281  2.267610
282  3.492160
283  3.796479
284  3.986027
285  4.128593
286  4.915794
287  2.766591
288  3.088987
289  4.062876
290  4.733865
291  2.532665
292  2.644143
293  4.671736
294  4.907683
295  2.619530
296  4.330256
297  4.540150
298  4.468416
299  4.408217
300  4.509882
301  2.557333
302  3.786042
303  3.823090
304  4.924685
305  2.629181
306  2.886823
307  2.856890
308  3.972212
309  4.798082
310  4.947516
311  4.719006
312  2.862103
313  3.151399
314  5.539055
315  5.596899
316  5.628073
317  3.624015
318  3.916553
319  3.814404
320  3.950626
321  2.968486
322  3.557476
323  4.353989
324  4.855559
325  4.989777
326  3.040191
327  3.658467
328  4.357171
329  4.725567
330  4.742621
331  4.907074
332  2.444602
333  3.012225
334  4.090983
335  4.951649
336  2.669453
337  2.760834
338  3.367194
339  3.702930
340  4.408293
341  4.390208
342  4.491873
343  3.084212
344  4.711958
345  2.608348
346  2.684029
347  4.831801
348  4.877319
349  5.049676
350  5.320099
351  3.075337
352  3.278667
353  3.233355
354  3.237303
355  4.184979
356  4.362440
357  5.220047
358  4.918215
359  5.019880
360  2.882785
361  3.510493
362  4.499740
363  5.051541
364  2.830081
365  3.599570
366  3.649831
367  4.147119
368  4.257684
369  4.761652
370  5.109344
371  3.083924
372  3.081308
373  3.763375
374  4.604864
375  5.169008
376  5.220379
377  5.082606
378  3.096028
379  3.450617
380  4.001224
381  4.109431
382  3.854498
383  3.982486
384  2.846522
385  2.848676
386  3.192308
387  3.321657
388  3.739729
389  3.969382
390  4.256315
391  4.331879
392  2.073098
393  2.456686
394  2.558351
395  4.167952
396  2.743960
397  2.736712
398  2.966716
399  2.629453
400  2.666938
401  3.103553
402  5.363492
403  5.362263
404  3.897497
405  5.160059
406  5.841586
407  6.097199
408  4.130943
409  3.543736
410  4.287839
411  4.486317
412  4.723892
413  3.272878
414  4.288768
415  4.632096
416  4.886612
417  5.009138
418  4.926769
419  2.995328
420  3.132929
421  3.857692
422  4.043048
423  4.409030
424  2.549495
425  2.941119
426  3.036243
427  3.501646
428  3.903340
429  4.034488
430  4.575362
431  2.456481
432  3.170180
433  3.281658
434  2.912962
435  4.340078
436  5.329102
437  5.521129
438  5.635900
439  5.531930
440  5.530415
441  3.455779
442  3.582166
443  3.551313
444  4.218249
445  4.474890
446  2.897777
447  2.968384
448  4.062417
449  2.931947
450  3.053282
451  5.458618
452  5.369262
453  2.839262
454  4.789493
455  4.817486
456  4.767151
457  2.660225
458  2.729114
459  4.430540
460  4.495708
461  4.597382
462  5.202339
463  3.079430
464  3.713005
465  3.918952
466  4.985257
467  5.441866
468  5.218278
469  4.038153
470  4.547639
471  4.665682
472  3.130276
473  3.869385
474  4.536334
475  4.919510
476  4.929889
477  4.957454
478  2.553271
479  4.351938
480  4.215579
481  4.317244
482  5.361612
483  5.653840
484  5.699357
485  3.532285
486  3.547194
487  4.957859
488  3.067483
489  3.864234
490  4.036506
491  4.426893
492  2.272295
493  2.373960
494  2.462408
495  3.018088
496  3.670244
497  3.853489
498  4.191385
499  4.286508
500  4.795318
501  5.223526
502  3.106528
503  3.760483
504  4.066400
505  4.468886
506  4.637553
507  4.936217
508  5.037882
509  2.907241
510  4.195498
511  4.431929
512  5.220876
513  5.436829
514  3.224802
515  3.116351
516  3.760569
517  5.083412
518  5.018452
519  5.043173
520  5.194098
521  5.270121
522  3.366775
523  3.874678
524  5.040029
525  4.976542
526  5.217468
527  3.183477
528  3.495015
529  3.912422
530  5.566877
531  5.565386
532  4.147240
533  4.581949
534  4.827975
535  5.216213
536  5.234016
537  5.416910
538  3.435908
539  3.662967
540  3.844501
541  5.349183
542  5.078157
543  4.398212
544  4.704436
545  4.907766
546  2.907962
547  2.917237
548  3.141246
549  4.191170
550  5.017062
551  5.106841
552  5.208507
553  3.144001
554  4.726759
555  5.020139
556  5.465972
557  3.014869
558  2.920088
559  3.231626
560  3.333291
561  3.630392
562  4.788755
563  5.137937
564  5.318669
565  3.237417
566  2.981885
567  3.290635
568  4.524461
569  4.673570
570  5.223260
571  5.199853
572  5.301518
573  2.719425
574  3.085767
575  3.078753
576  5.109858
577  5.263929
578  5.593304
579  2.626253
580  3.713043
581  5.016790
582  5.212417
583  3.314028
584  3.422581
585  3.374056
586  4.066651
587  4.543464
588  2.648285
589  2.750062
590  2.892932
591  3.581336
592  4.112736
593  5.178329
594  5.302233
595  5.299733
596  2.845422
597  3.655002
598  2.898747
599  3.657655
600  3.775697
601  4.216584
602  4.769096
603  4.947799
604  2.537327
605  2.842323
606  3.872433
607  4.411163
608  4.782316
609  4.883981
610  5.136464
611  2.886335
612  3.110439
613  3.317512
614  4.947688
615  4.659069
616  4.898308
617  4.999973
618  2.769656
619  3.370036
620  5.027760
621  3.173592
622  4.960666
623  4.849045
624  4.977479
625  2.697097
626  2.774246
627  3.221586
628  3.696949
629  4.441562
630  5.014518
631  5.068157
632  2.916106
633  3.248889
634  3.877077
635  4.050299
636  4.699158
637  5.635313
638  5.653492
639  5.508185
640  2.753978
641  2.903309
642  4.120505
643  4.326430
644  4.938927
645  5.286292
646  2.967693
647  4.987289
648  3.280949
649  4.103871
650  4.830928
651  4.913356
652  5.229886
653  3.042462
654  2.909386
655  3.863469
656  4.293211
657  4.974375
658  3.412659
659  3.343541
660  3.607413
661  5.331385
662  5.792482
663  3.699589
664  3.689617
665  4.098684
666  4.982861
667  3.447560
668  5.156614
669  5.472099
670  5.505290
671  3.240108
672  3.774535
673  4.543603
674  5.203654
675  2.748155
676  4.088021
677  5.207170
678  5.415535
679  3.121611
680  4.184577
681  4.801594
682  5.612338
683  5.750050
684  5.711507
685  5.543067
686  3.236145
687  4.316866
688  4.896835
689  5.249253
690  5.606994
691  5.732811
692  4.261986
693  3.688310
694  3.786358
695  5.444923
696  3.402429
697  3.550631
698  3.549162
699  4.597356
700  4.804429
701  3.576489
702  3.580436
703  3.682102
704  3.852100
705  4.466180
706  5.289015
707  5.337457
708  5.422274
709  3.752341
710  4.416575
711  5.277683
712  5.552833
713  4.863917
714  5.385144
715  5.683687
716  3.005682
717  3.158409
718  3.574883
719  3.327763
720  3.608884
721  5.639988
722  5.705362
723  3.333181
724  3.425033
725  3.530646
726  4.571690
727  5.213451
728  5.421649
729  5.445776
730  5.423067
731  5.522138
732  3.354879
733  4.660981
734  4.896046
735  5.086059
736  3.685763
737  4.264123
738  4.555682
739  5.077461
740  5.264085
741  5.484015
742  5.376120
743  5.494839
744  5.441859
745  3.492775
746  4.585848
747  5.430818
748  5.745267
749  3.692994
750  4.463641
751  4.946560
752  5.187166
753  3.129869
754  3.344507
755  4.509066
756  5.483164
757  3.174991
758  4.809945
759  5.462762
760  5.852437
761  5.924619
762  3.781997
763  3.883663
764  5.411801
765  5.433401
766  3.023317
767  3.317909
768  3.616205
769  4.787520
770  4.895727
771  5.308515
772  3.361324
773  3.439711
774  3.887162
775  5.179036
776  5.370729
777  5.478272
778  4.307183
779  4.723002
780  5.308276
781  5.586975
782  5.717884
783  3.465627
784  3.828565
785  4.529710
786  5.123792
787  5.391269
788  3.893364
789  4.014588
790  4.660389
791  5.553478
792  5.896511
793  6.117883
794  5.483102
795  5.516878
796  5.553014
797  6.156425
798  3.609950
799  3.981811
800  5.034766
801  5.639684
802  5.997420
803  3.307653
804  3.510872
805  5.273557
806  5.582505
807  5.663708
808  3.636721
809  3.738498
810  3.783235
811  5.734368
812  5.755812
813  3.380328
814  4.475578
815  6.154491
816  3.780566
817  5.002295
818  5.516958
819  5.888040
820  5.990051
821  6.045129
822  3.945052
823  3.939734
824  4.124885
825  4.401212
826  5.700750
827  5.900026
828  6.042225
829  3.896871
830  3.913560
831  3.834489
832  4.074662
833  3.710314
834  3.692896
835  5.150731
836  5.221680
837  5.908040
838  5.394689
839  5.554408
840  5.297204
841  5.612484
842  5.602199
843  5.733348
844  3.961498
845  4.467794
846  5.432525
847  4.111306
848  4.307072
849  5.584231
850  3.397704
851  5.721825
852  6.097980
853  3.534852
854  4.146531
855  4.697241
856  4.924985
857  5.103533
858  5.205199
859  5.021901
860  5.279231
861  5.618924
862  5.933185
863  5.917462
864  6.014037
865  5.358926
866  6.011613
867  5.996932
868  5.876478
869  3.825043
870  5.263346
871  5.562540
872  3.784965
873  4.381852
874  6.175240
875  6.257257
876  3.924571
877  4.590258
878  5.368141
879  5.424272
880  5.259218
881  5.614458
882  5.808848
883  3.458882
884  4.203871
885  5.096158
886  5.112431
887  5.909707
888  3.736389
889  4.780083
890  5.709888
891  5.728068
892  5.872531
893  3.439520
894  5.393025
895  5.670006
896  5.838434
897  5.851852
898  3.750512
899  3.852177
900  4.087028
901  5.383196
902  5.731632
903  5.757172
904  3.310752
905  3.792520
906  5.527786
907  5.659041
908  3.876470
909  4.799973
910  5.954466
911  5.866685
912  3.894331
913  4.201356
914  4.754895
915  4.034645
916  4.294903
917  4.135411
918  5.126092
919  5.751925
920  4.118617
921  4.140068
922  4.238462
923  5.510106
924  5.514833
925  6.122003
926  6.111719
927  5.958405
928  3.721505
929  3.823171
930  4.871575
931  5.056508
932  4.829303
933  4.832125
934  4.864563
935  4.930181
936  5.486521
937  5.491020
938  3.365198
939  5.969452
940  6.096515
941  4.608301
942  5.583316
943  5.742148
944  6.047683
945  6.282406
946  4.106197
947  5.534768
948  5.682297
949  5.802141
950  5.867675
951  3.510024
952  5.144820
953  5.579979
954  6.092497
955  6.364928
956  4.772844
957  5.157481
958  6.108064
959  6.286326
960  6.269568
961  6.284477
962  3.851886
963  4.688702
964  3.543574
965  3.581748
966  3.666587
967  4.360723
968  5.663790
969  5.873616
970  5.736803
971  3.331837
972  3.869646
973  4.076719
974  4.413137
975  5.648182
976  5.736742
977  6.004253
978  6.181465
979  6.347401
980  5.252565
981  4.913321
982  4.944602
983  5.219228
984  5.343834
985  5.340203
986  3.212133
987  3.201849
988  3.405068
989  5.440742
990  5.624291
991  5.685277
992  3.812255
993  3.647706
994  3.736154
995  3.766659
996  4.112557
997  5.419313
998  5.598702
999  3.770887
1000 4.045377
 [ reached getOption("max.print") -- omitted 2474 rows ]

mae <- mean(abs(y_test - lasso_pred))
mse <- mean((y_test - lasso_pred)^2)
r_squared <- 1 - (sum((y_test- lasso_pred)^2) / sum((y_test - mean(y_test))^2))
mae

[1] 0.8307075

mse1

Error: object 'mse1' not found

day1$cnt <- log(day1$cnt)
mod_forward <- lm(formula = cnt ~ temp + hr + yr + hum + season + holiday + 
    windspeed + weathersit + workingday, data = day1)
plot(mod_forward, which = c(1,2,3,4))

mod_backward <- lm(formula = cnt ~ season + yr + hr + holiday + workingday + 
    weathersit + temp + hum + windspeed, data = day1)
plot(mod_backward, which = c(1,2,3,4))

# Check the variance 
library(car)

Warning: package ‘car’ was built under R version 4.1.2Loading required package: carData
Warning: package ‘carData’ was built under R version 4.1.2
Attaching package: ‘car’

The following object is masked from ‘package:dplyr’:

    recode

ncvTest(fit.all)

Non-constant Variance Score Test 
Variance formula: ~ fitted.values 
Chisquare = 2063.008, Df = 1, p = < 2.22e-16

library(plyr)

Warning: package ‘plyr’ was built under R version 4.1.2----------------------------------------------------------------------------
You have loaded plyr after dplyr - this is likely to cause problems.
If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
library(plyr); library(dplyr)
----------------------------------------------------------------------------

Attaching package: ‘plyr’

The following objects are masked from ‘package:dplyr’:

    arrange, count, desc, failwith, id, mutate, rename, summarise,
    summarize

library(readr)

Warning: package ‘readr’ was built under R version 4.1.2

library(dplyr)
library(glmnet)

Warning: package ‘glmnet’ was built under R version 4.1.2Loaded glmnet 4.1-6

library(tibble) 

Warning: package ‘tibble’ was built under R version 4.1.2

library(caret)

Warning: package ‘caret’ was built under R version 4.1.2Loading required package: lattice

set.seed(42)
train_index <- createDataPartition(day1$cnt, p = 0.8, list = FALSE)
train_set <- day1[train_index,]
test_set <- day1[-train_index,]

# Train the multiple linear regression model
model <- lm(formula = cnt ~ season + yr + hr + holiday + workingday + 
    weathersit + temp + hum + windspeed, data = train_set)

# Make predictions on the test set
predictions <- predict(model, newdata = test_set)

# Evaluate the model
mae <- mean(abs(test_set$cnt - predictions))
mse <- mean((test_set$cnt - predictions)^2)
r_squared <- 1 - (sum((test_set$cnt - predictions)^2) / sum((test_set$cnt - mean(test_set$cnt))^2))

cat('Mean Absolute Error:', mae, '\n')

Mean Absolute Error: 0.8430607 

cat('Mean Squared Error:', mse, '\n')

Mean Squared Error: 1.156954 

cat('R-squared:', r_squared, '\n')

R-squared: 0.4713828 

rmse <- function(actual, predicted) {
  return(sqrt(mean((actual - predicted)^2)))
}
rmse_value <- rmse(test_set$cnt, predictions)
cat('Root Mean Squared Error:', rmse_value, '\n')

Root Mean Squared Error: 1.075618 

day2 <- day1[ , -which(names(day1) == "cnt")]
pca <- prcomp(day2,scale=TRUE)
variance <- summary(pca)$importance[2,]
df <- data.frame(Component = 1:length(variance), Variance = variance)
df_top_10 <- df[1:10,]
df_top_10 <- df_top_10[order(-df_top_10$Variance),]
df_top_10

pc <- pca$rotation[, 1: 10]
z <- melt(pc)
colnames(z) <- c("Variable", "PC", "value")
plot <- ggplot(z, aes(x = PC, y = Variable, fill= value)) +
 geom_tile(color = 'white')+
 scale_fill_gradient2(low = 'brown', high = 'wheat', mid = 'ivory',
   midpoint = 0, limit = c(-1,1), space = 'Lab')
plot

pca_data <- as.data.frame(predict(pca))
df2 <- pca_data[, 1:2]
df1 <- subset(day1, select = cnt)
combined_df <- cbind(df1, df2)
library(caret)
train_index <- createDataPartition(combined_df$cnt, p = 0.8, list = FALSE)
train_set <- combined_df[train_index,]
test_set <- combined_df[-train_index,]
# Train the multiple linear regression model
model2 <- lm(cnt ~ ., data = train_set)
summary(model2)

Call:
lm(formula = cnt ~ ., data = train_set)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.9418 -0.4606  0.1181  0.6162  2.7952 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 4.537284   0.007966  569.55   <2e-16 ***
PC1         0.720840   0.005032  143.24   <2e-16 ***
PC2         0.113545   0.005553   20.45   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.9394 on 13901 degrees of freedom
Multiple R-squared:  0.601, Adjusted R-squared:  0.601 
F-statistic: 1.047e+04 on 2 and 13901 DF,  p-value: < 2.2e-16

# Make predictions on the test set
predictions <- predict(model2, newdata = test_set)
# Evaluate the model
mae <- mean(abs(test_set$cnt - predictions))
mse <- mean((test_set$cnt - predictions)^2)
r_squared <- 1 - (sum((test_set$cnt - predictions)^2) / sum((test_set$cnt - mean(test_set$cnt))^2))
summary(predictions)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  1.916   3.689   4.405   4.555   5.292   8.573 

r_squared

[1] 0.590504

mae

[1] 0.7150052

mse

[1] 0.8998416